home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / macdes.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  4.0 KB  |  133 lines
  1. ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;;     The data in this file contains enhancments.                    ;;;;;
  4. ;;;                                                                    ;;;;;
  5. ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
  6. ;;;     All rights reserved                                            ;;;;;
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8.  
  9. (in-package "MAXIMA")
  10.  
  11. (defconstant *doc-start* (code-char 31))
  12.  
  13. (defvar $manual_demo "manual.demo")
  14.  
  15. (defmspec $example (l)   (setq l (cdr l))
  16.   (block
  17.    $example
  18.    (let ((example (car l))
  19.      (file (or (cadr l)  (maxima-path "doc" $manual_demo))))
  20.      (or (symbolp example)
  21.      (merror
  22.       "First arg ~M to example must be a symbol, eg example(functions)"))
  23.      (setq file ($file_search1 $manual_demo '((mlist) $file_search_demo)))
  24.      (with-open-file
  25.       (st file)
  26.       (let ( ;*mread-prompt*
  27.          )
  28.     (prog ( tem  all c-tag d-tag)
  29.  
  30.       AGAIN
  31.       (setq tem (read-char st nil))
  32.       (or tem (go NOTFOUND))
  33.       (or (eql tem #\&) (go AGAIN))
  34.       (setq tem (read-char st nil))
  35.       (or (eql tem #\&) (go AGAIN))
  36.       ;; so we are just after having read &&
  37.       
  38.       (setq tem (read st nil nil))
  39.       (or tem (go NOTFOUND))
  40.       (setq tem ($concat tem))
  41.       (cond ((eql tem example)
  42.          (go DOIT))
  43.         (t (push tem all)
  44.            (go AGAIN)))
  45.       ;; at this stage we read maxima forms and print and eval
  46.       ;; until a peek sees '&' as the first character of next expression.
  47.       DOIT
  48.       (setq tem (peek-char nil st nil))
  49.       (cond ((or (null tem) (eql tem #\&))
  50.          (return-from $example '$done)))
  51.       (setq tem (dbm-read st nil nil))
  52.       (setq $linenum (+ 1 $linenum))
  53.       (set (setq c-tag (makelabel $inchar)) (nth 2 tem))
  54.       (let ($display2d)
  55.         (displa `((mlable) ,c-tag ,(nth 2 tem)))
  56.         ;(mformat nil "Input: ~M;" (nth 2 tem))
  57.         )
  58.       (setq $% (meval* (nth 2 tem)))
  59.       (SET (setq d-tag (makelabel $outchar)) $%)
  60.       (if (eq (caar tem) 'displayinput)
  61.           (displa `((mlable) ,d-tag ,$%)))
  62.       ;(mformat nil "==> ~M"  (setq $% (meval* (nth 2 tem))))
  63.       (go DOIT)     
  64.  
  65.       NOTFOUND
  66.        (format t "Not Found.  You can look at:")
  67.        (return-from $example
  68.          `((mlist) ,@ (nreverse all)))
  69.        ))))))
  70.  
  71. (defun mread-noprompt (&rest read-args)
  72.   (let ((*mread-prompt* ""))
  73.     (declare (special *mread-prompt*))
  74.     (or read-args (setq read-args (list *query-io*)))
  75.   (caddr (apply #'mread read-args))))
  76.  
  77. ;; Some list creation utilities.
  78.  
  79. (defmspec $create_list(l) (setq l (cdr l))
  80.    (create-list2 (car l) (cdr l)))
  81.  
  82. (defun create-list2 (form l)
  83.   (cons '(mlist) (apply 'create-list1 form l)))
  84.  
  85. (defun create-list1(form &rest l &aux lis var1 top)
  86.   (cond ((null l)(list (meval* form)))
  87.     (t
  88.      (setq var1 (car l)
  89.            lis (second l)
  90.            l (cddr l))
  91.      (or (symbolp var1) (merror "~A not a symbol" var1))
  92.       (setq lis (meval* lis))
  93.      (progv (list var1)
  94.         (list nil)
  95.         (cond ((and (numberp lis)
  96.                 (progn
  97.                   (setq top (car l) l (cdr l))
  98.                   (setq top (meval* top))
  99.                   (numberp top)))
  100.                (sloop for i from lis to top
  101.                   nodeclare t
  102.                   do (set var1 i)
  103.                   append
  104.                   (apply 'create-list1
  105.                      form l)))
  106.               (($listp lis)
  107.                (sloop for v in (cdr lis)
  108.                   do (set var1 v)
  109.                   append
  110.                   (apply 'create-list1
  111.                      form l)
  112.                   ))
  113.               (T (merror "BAD ARG")))))))
  114. (defvar *info-paths* nil)
  115.  
  116.  
  117.  
  118. (defun $describe(x &aux (*info-paths* *info-paths*) have)
  119.   (setq x ($sconcat x))
  120.   (if (and (find-package "SI")
  121.            (fboundp (intern "INFO" "SI")))
  122.       (return-from $describe (funcall (intern "INFO" "SI") x
  123.          '("maxima.info") #-gcl *info-paths*)))
  124.  
  125.   "The documentation is now in INFO format and can be printed using
  126. tex, or viewed using info or gnu emacs or using a web browser:
  127. http://www.ma.utexas.edu/maxima/
  128.    Some versions of maxima built have a builtin info retrieval mechanism."
  129.   )
  130.  
  131. (defun $apropos ( s ) 
  132.   (cons '(mlist) (apropos-list s "MAXIMA"))) 
  133.